00100	ENTRY IIICVT;
00200	BEGIN "DPYSUB"
00300	DEFINE ⊃="COMMENT", REAL_ARRAY="SAFE REAL ARRAY",
00400			    INTEGER_ARRAY="SAFE INTEGER ARRAY";
00500	EXTERNAL INTEGER PROCEDURE GVECW(INTEGER X,Y,OP,SIZ,BRT);
00600	EXTERNAL INTEGER PROCEDURE DPYPARS;
     

00100	INTERNAL PROCEDURE DDOUT(INTEGER_ARRAY DDBUF);
00200	BEGIN	INTEGER FOO,FOO2;
00300		FOO←POINT(0,DDBUF[1],35);
00400		FOO2←ARRINFO(DDBUF,0);
00500	START_CODE DEFINE UPGIOT="'715140000000";
00600		UPGIOT FOO;
00700	END;
00800	END "DDOUT";
00900	
01000	INTERNAL INTEGER DDCHAN;
01100	
01200	INTERNAL PROCEDURE DDCLR;
01300	BEGIN	INTEGER I,WD;DEFINE INVERT="'10000000000";
01400		INTEGER ARRAY DDBUF[1:3];
01500		WD←'126004001324+INVERT;
01600		DPB(DDCHAN,POINT(8,WD,23));
01700		DDBUF[1]←WD;DDBUF[2]←WD;
01800		DDOUT(DDBUF);
01900	END "DDCLR";
02000	
02100	INTERNAL BOOLEAN OVERLAY;
02200	
02300	PROCEDURE DDFIX(INTEGER CHAN;INTEGER ARRAY DDBUF;
02400			INTEGER C0,L0,LL,SIZL);
02500	BEGIN	INTEGER CHANWD,DDPTR,DDLNO,FIELD,CWD;
02600		CHANWD←'002004003324;DPB(CHAN,POINT(8,CHANWD,23));
02700		DPB(C0,POINT(7,CHANWD,15));
02800		CWD←'116000001454+(IF OVERLAY THEN '040000000000 ELSE 0);
02900		DDPTR←POINT(36,DDBUF[1],-1);
03000		FOR FIELD←0 STEP 1 UNTIL 3 DO
03100		 BEGIN "FIELD"
03200		   FOR DDLNO←L0+FIELD STEP 4 UNTIL LL DO
03300		    BEGIN "LINE"
03400			DPB(DDLNO,POINT(4,CWD,23));
03500			DPB(DDLNO LSH -4,POINT(5,CWD,15));
03600			IDPB(CWD,DDPTR);IDPB(CHANWD,DDPTR);
03700			DDPTR←DDPTR+SIZL;
03800			CWD←'454;
03900		    END "LINE";
04000		 END "FIELD";
04100		IDPB('000004010334,DDPTR);IDPB(0,DDPTR);
04200	END "DDFIX";
     

00100	INTERNAL INTEGER GFSIZX,GFSIZY,GFSIZL,X0,Y0,SCALX,SCALY,
00200			 XCENT,YCENT,LMAR,RMAR,YBOT,CHSCAL;
00300	INTERNAL REAL ASPECT,CHASP,SQALE;
00400	INTERNAL INTEGER DDPOSX,DDPOSY,DDORGX,DDORGY;
00500	EXTERNAL PROCEDURE IIIWD(INTEGER WD);
00600	INTERNAL INTEGER ARRAY DDBUF[1:5210];
00700	REQUIRE "CHRTBL" LOAD_MODULE;
00800	INTERNAL PROCEDURE IIISUB(INTEGER_ARRAY DPYBUF);
00900	BEGIN	INTEGER IFRST;
01000		IFRST←DDPOSX LAND 7;
01100		GFSIZL←(IFRST+GFSIZX-1) LSH -5 +1;
01200	BEGIN
01300	INTERNAL INTEGER_ARRAY PTTAB[0:GFSIZX],LINTAB[0:GFSIZY-1];
01400		INTEGER LIN,FPT,PTPT,OPT,DPSIZ;
01500		INTEGER I,OP,DPWD,FIELD,DPYLO;
01600		DEFINE DDCODE="2";
01700		DPYLO←ARRINFO(DPYBUF,1);
01800		DPSIZ←DPYBUF[DPYLO+1];
01900		FPT←POINT(1,DDBUF[3],IFRST-1);
02000		PTPT←POINT(36,PTTAB[0],-1);
02100		OPT←POINT(1,DDBUF[3],-1);
02200		START_CODE
02300		 DEFINE PT="1",J="2",I="3";LABEL LI,LJ,LE;
02400		 MOVE PT,FPT;MOVEI I,31;SUB I,IFRST;MOVE J,GFSIZX;
02500	LJ:	 ADD PT,['4000000];
02600	LI:	 IBP PT;IDPB PT,PTPT;SOJLE J,LE;SOJGE I,LI;
02700		 AOS PT,OPT;MOVEI I,31;JRST LJ;
02800	LE:	END;
02900		I←0;
03000		FOR FIELD←0 STEP 1 UNTIL 3 DO
03100		FOR LIN←FIELD STEP 4 UNTIL GFSIZY-1 DO
03200		 BEGIN LINTAB[LIN]←I*(GFSIZL+2);I←I+1;END;
03300		DDBUF[1]←DDCODE;ARRBLT(DDBUF[2],DDBUF[1],ARRINFO(DDBUF,0)-1);
03400	
03500		IIIWD(GVECW(0,0,'146,2,0));
03600		FOR I←1 STEP 1 UNTIL DPSIZ DO IIIWD(DPYBUF[I+DPYLO+1]);
03700	DDFIX(DDCHAN,DDBUF,DDPOSX LSH -3+1,DDPOSY,DDPOSY+GFSIZY-1,GFSIZL);
03800	END;
03900	END "IIISUB";
04000	
04100	INTERNAL  PROCEDURE IIICVT(INTEGER_ARRAY DPYBUF);
04200	BEGIN
04300		IF ASPECT=0 THEN ASPECT←.85;
04400		IF CHASP=0 THEN CHASP←ASPECT;
04500		GFSIZX←336; GFSIZY←400; GFSIZL←11 ;
04600		IF SQALE=0 THEN SQALE←480/1024;
04700		SCALY←SQALE*(1 LSH 18);
04800		SCALX←ASPECT*SCALY;
04900		IF CHSCAL=0 THEN CHSCAL←SCALY;
05000		XCENT←256 LSH 18;YCENT←240 LSH 18;
05100		DDPOSX←64; DDPOSY←24;
05200		LMAR←0;RMAR←1023*SCALX;
05300		YBOT←479 LSH 18;
05400		IIISUB(DPYBUF);
05500	END "IIICVT";
05600	
05700	END "DPYSUB";